home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / ELECTRON / PCB_DESI / H027.ZIP / TOOLS.EXE / lha / GERB_LMC.PAS < prev    next >
Pascal/Delphi Source File  |  1990-11-21  |  5KB  |  227 lines
  1. program gerb_lmc;
  2.  
  3. { convert gerber files to layo1 .LMC files}
  4.  
  5. uses
  6.   crt,
  7.   dos;
  8.  
  9. const
  10.   layer : byte = 1;
  11.  
  12. type
  13.   string80 = string[80];
  14.  
  15.   array_type_integer = array[1..maxint] of integer;
  16.   array_type_word    = array[1..maxint] of word;
  17.  
  18. var
  19.   ch : char;
  20.   top_array : word;
  21.  
  22.   attr : ^array_type_word;
  23.   xpos,
  24.   ypos : ^array_type_integer;
  25.  
  26.   apert_pen : array[10..99] of byte;
  27.   apert_pad : array[10..99] of byte;
  28.  
  29. procedure save_lmc;
  30. type
  31.   lrec = record b,a:word; x,y:integer; end;
  32. var
  33.   rec : lrec; f1 : file of lrec; i:word;
  34. begin
  35.   assign(f1,paramstr(2));
  36.   rewrite(f1);
  37.   for i:=1 to top_array do
  38.   begin
  39.     rec.b:= 0;
  40.     rec.a:=attr^[i];
  41.     rec.x:=xpos^[i];
  42.     rec.y:=ypos^[i];
  43.     write(f1,rec);
  44.   end;
  45.   close(f1);
  46. end;
  47.  
  48. procedure init;
  49. var
  50.   i : word;
  51. begin
  52.   top_array := 0;
  53.   new(xpos);
  54.   new(ypos);
  55.   new(attr);
  56.   fillchar(attr^,sizeof(attr^),0);
  57.   fillchar(xpos^,sizeof(xpos^),0);
  58.   fillchar(ypos^,sizeof(ypos^),0);
  59.   val(paramstr(3),layer,i);
  60. end;
  61.  
  62. procedure load_aperture_dat;
  63. var
  64.   f1:text;
  65.   s1:string;
  66.   apert_str : string[2];
  67.   pen_str,
  68.   pad_str : string;
  69.   i,apert,pen,pad : word;
  70. begin
  71.   fillchar(apert_pen,sizeof(apert_pen),1);
  72.   fillchar(apert_pad,sizeof(apert_pad),0);
  73.   assign(f1,'aperture.dat');
  74.   reset(f1);
  75.   while not eof(f1) do
  76.   begin
  77.     readln(f1,s1);
  78.     if (pos('D',s1) = 1) and (pos('*',s1) = 4) then
  79.     begin
  80.       apert_str := copy(s1,2,2);
  81.       val(apert_str,apert,i);
  82.       if apert >9 then
  83.       begin
  84.         i := pos('PEN',s1);
  85.         if i > 0 then
  86.         begin
  87.           inc(i,4);
  88.           pen_str := '';
  89.           while (i<=length(s1)) and (s1[i] in ['0'..'9']) do
  90.           begin
  91.             pen_str := pen_str + s1[i];
  92.             inc(i);
  93.           end;
  94.           val(pen_str,pen,i);
  95.           apert_pen[apert] := pen;
  96.         end;
  97.         i := pos('PAD',s1);
  98.         if i > 0 then
  99.         begin
  100.           inc(i,4);
  101.           pad_str := '';
  102.           while (i<=length(s1)) and (s1[i] in ['0'..'9']) do
  103.           begin
  104.             pad_str := pad_str + s1[i];
  105.             inc(i);
  106.           end;
  107.           val(pad_str,pad,i);
  108.           apert_pad[apert] := pad;
  109.         end;
  110.       end;
  111.     end;
  112.     writeln(s1);
  113.   end;
  114.   close(f1);
  115. end;
  116.  
  117. {
  118. D01* = PEN DOWN
  119. D02* = PEN UP
  120. D03* = FLASH
  121. D11* = PEN 1
  122. D12* = PEN 2
  123. D13* = PEN 3
  124. D14* = PEN 4
  125. D15* = PEN 5
  126. D16* = PEN 6
  127. D17* = PEN 7
  128. D30* = PEN 1    PAD 0
  129. D31* = PEN 1    PAD 7
  130. D32* = PEN 1    PAD 9
  131.  
  132. }
  133.  
  134.  
  135.  
  136. procedure mess(w:string80);
  137. begin
  138.   writeln(#13#10,w);
  139.   halt;
  140. end;
  141.  
  142.  
  143. procedure load_gerber;
  144. var
  145.   f1:text;
  146. {  nummer : char;}
  147.   xs,ys,ds,dummy_str : string80;
  148.   dummy_int : integer;
  149.   xr,yr:real;
  150.   i,x,y : integer;
  151.   pen,pad:word;
  152.   gerb_str : string80;
  153.   apert : word;
  154. begin
  155.   writeln(#10#10#13,'Reading ',paramstr(1));
  156.   assign(f1,paramstr(1));
  157.   {$i-} reset(f1); {$I+}
  158.   if ioresult <> 0 then
  159.   begin
  160.     writeln('Gerber file ',paramstr(1),' not open...');
  161.     halt;
  162.   end;
  163.   while not eof(f1) do
  164.   begin
  165.     readln(f1,gerb_str);
  166.     if length(gerb_str) > 0 then
  167.     begin
  168.       if gerb_str[1] = 'D' then {select aperture}
  169.       begin
  170.         dummy_str := copy(gerb_str,2,2);
  171.         val(dummy_str,apert,dummy_int);
  172.         pen := apert_pen[apert];
  173.         pad := apert_pad[apert];
  174.  
  175. {       writeln('PEN = ',pen,'  PAD = ',pad);
  176.         ch := readkey;
  177. }
  178.       end;
  179.       if gerb_str[1] = 'X' then
  180.       begin
  181.         if top_array < 30000 then inc(top_array) else mess('full');
  182.         xs := copy(gerb_str,2,pos('Y',gerb_str)-2);
  183.         ys := copy(gerb_str,pos('Y',gerb_str)+1,pos('D',gerb_str) - pos('Y',gerb_str)-1);
  184.         ds := copy(gerb_str,pos('D',gerb_str)+1,pos('*',gerb_str) - pos('D',gerb_str)-1);
  185.  
  186.         if ((xs[1] = '-') or (xs[1] = '+')) and (pos('.',xs) = 0)
  187.         then insert('.',xs,4);
  188.         if ((ys[1] = '-') or (ys[1] = '+')) and (pos('.',ys) = 0)
  189.         then insert('.',ys,4);
  190.         if pos('.',xs) = 0 then insert('.',xs,3);
  191.         if pos('.',ys) = 0 then insert('.',ys,3);
  192. {        writeln(#13#10' XS =',xs,' YS =',ys,' DS =',ds); }
  193.         val(xs,xr,x);
  194.         val(ys,yr,y);
  195.         x := round(xr * 1280);
  196.         y := round(yr * 1280);
  197. {        writeln(hoogsteregel,'  X = ',x,' Y = ',y,' ',ds);}
  198.         xpos^[top_array] := x;
  199.         ypos^[top_array] := y;
  200.         if ds = '01' then attr^[top_array] := (layer shl 3) + pen {pd} else
  201.         if ds = '02' then attr^[top_array] := (layer shl 3)       {pu} else
  202.         if ds = '03' then attr^[top_array] := $80 + (pad shl 3);
  203.       end;
  204.     end;
  205.   end;
  206.   close(f1);
  207. end;
  208.  
  209.  
  210. begin
  211.   if paramcount < 2 then
  212.   begin
  213.     clrscr;
  214.     writeln('type   GERBLAYO source destination [layer]');
  215.     writeln;
  216.     writeln('Example : gerblayo a:\demo.g01 c:\layo1p\demo.lmc 2');
  217.     writeln;
  218.     halt;
  219.   end;
  220.   init;
  221.   load_aperture_dat;
  222.   load_gerber;
  223.   save_lmc;
  224.   writeln('ok...');
  225. end.
  226.  
  227.